home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 30 / 030.d81 / klondike solitai (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  5KB  |  129 lines

  1. 10 gosub910:clr:poke53280,12:poke53281,1
  2. 20 printchr$(142)"[147][144]"spc(12)"klondike solitaire"
  3. 30 printspc(11)"shuffling the deck..."
  4. 40 poke56334,peek(56334)and254:poke1,peek(1)and251:b=12288
  5. 50 c=53248:fori=0to2047:pokei+b,peek(i+c):next:poke1,peek(1)or4
  6. 60 poke56334,peek(56334)or1
  7. 70 poke53272,(peek(53272)and240)+12
  8. 80 dim c$(52),d(7,25),p(7),nu(7),u(52),b(27),dk(27),ck(52,2)
  9. 90 data a,2,3,4,5,6,7,8,9,@,j,q,"k" : b$="    [157][157][157][157]    [157][157][157][157]    [157][157][157][157]"
  10. 100 n$="" : q$(1)="[144] [193]":q$(2)=" [211]":q$(3)=" [218]":q$(4)="[144] [216]"
  11. 110 fori=1to12:forj=1to2:ck(i,j)=14*j+i+(j=2):next:next
  12. 120 fori=14to25:forj=0to1:ck(i,j+1)=39*j+i-12:next:next
  13. 130 fori=27to38:forj=0to1:ck(i,j+1)=39*j+i-25:next:next:ck(0,0)=-1
  14. 140 ck(0,1)=-1:fori=40to51:forj=1to2:ck(i,j)=14*j+i+(j=2)-39:next:next
  15. 150 fori=1to4:restore:forj=1to13:readc$
  16. 160 c$((i-1)*13+j)="[207][183][183][208][157][157][157][157][165]"+q$(i)+"[157][157]"+c$+"[144][167][157][157][157][157][204][175][175][186][157][157][157][157]":next:next
  17. 170 fori=0to7:reada:pokeb+i,a:next:data 158,146,146,146,146,146,158,0
  18. 180 fori=1to52:u(i)=0:next:fori=1to27:b(i)=0:dk(i)=0:next:dp=0:print"[147]"
  19. 190 fori=1to7:p(i)=i:forj=1toi
  20. 200 x=int(rnd(0)*52)+1:ifu(x)then200
  21. 210 u(x)=-1:d(i,j)=x
  22. 220 next:nu(i)=i-1:next:fori=1to4:nf(i)=0:next
  23. 230 x=int(rnd(0)*52)+1:ifu(x)then230
  24. 240 u(x)=-1 : dk(dp+1)=x : dp=dp+1 : if dp<24 then goto230
  25. 250 c$(0)=b$:nd=24
  26. 260 print"[147]           klondike solitaire"
  27. 270 print"spades  hearts  diamonds   clubs    bone";
  28. 280 fori=1to4:ifnf(i)=0thenprintspc(9);:goto300
  29. 290 printc$(13*(i-1)+nf(i))"[145][145][145] ";
  30. 300 next:printc$(b(1))
  31. 310 print"  1 ";:fori=2to7:print"   "i;:next:print"[145]"
  32. 320 printspc(6);:fori=2to7
  33. 330 ifnu(i)thenprint"  "chr$(nu(i)+48)" [146][144]";:goto350
  34. 340 print spc(4);
  35. 350 ifi<7thenprint"  ";
  36. 360 next
  37. 370 fori=1to7:np=0:b=nu(i):ifp(i)=0thenprint"";:goto420
  38. 380 ifp(i)-b>5thenb=p(i)-4:printc$(d(i,nu(i)+1))"[145]";:np=1
  39. 390 forj=b+1top(i):printc$(d(i,j))"[145]";:next:print"";:np=np+p(i)-b
  40. 400 ifnp>1thenfork=2tonp:print"[145][145]";:next
  41. 410 ifi<7thenprint"[145][145][145]  ";
  42. 420 next
  43. 430 print"number of cards in deck:"nd"[144]"
  44. 440 u=0:fori=1to4:u=u+nf(i):next:ifu<52then460
  45. 450 print""spc(40)"            you have won !!":fort=1to2000:next:nw=-1:run20
  46. 460 ifdk(1)>0orb(1)>0then490
  47. 470 u=0:fori=1to7:u=u+nu(i):next:ifu>0then490
  48. 480 print"      your victory is inevitable!!"
  49. 490 w$="":print"[144][146]play: 1-7, b)one d)raw q)uit n)ew ->";
  50. 500 poke198,0:wait198,1:getw$:w=val(w$):if w>0 and w<8 thenprintw$:goto580
  51. 510 nw=0:ifw$="n"thenw$="q":nw=1
  52. 515 ifw$<>"b"andw$<>"d"andw$<>"q"then500
  53. 517 printw$
  54. 520 on -(w$="b")-2*(w$="d")-3*(w$="q")+1 goto490,530,690,760
  55. 530 gosub810:q=b(1):ifw$<>""then560
  56. 540 ifc1=ck(q,1)orc1=ck(q,2)thenp(l)=p(l)+1:d(l,p(l))=b(1):goto860
  57. 550 goto870
  58. 560 if b(1)-1 = 13*(s-1)+nf(s) then nf(s)=nf(s)+1 : goto860
  59. 570 goto870
  60. 580 w=val(w$):ifp(w)=0then870
  61. 590 w=val(w$):gosub810:q=d(w,p(w)):ifw$<>""or(w=l)then650
  62. 600 fori=p(w)tonu(w)+1step-1:b=d(w,i):ifck(b,1)<>c1andck(b,2)<>c1then640
  63. 610 forj=ito p(w):d(l,p(l)+j-i+1)=d(w,j):next
  64. 620 p(l)=p(l)+p(w)-i+1:p(w)=i-1:p(w)=-(p(w)>=0)*p(w):p(l)=-(p(l)>=0)*p(l)
  65. 630 goto670
  66. 640 next : goto870
  67. 650 ifq-1<>13*(s-1)+nf(s)then870
  68. 660 nf(s)=nf(s)+1:p(w)=p(w)-1
  69. 670 ifp(w)=nu(w)andnu(w)>0thennu(w)=nu(w)-1
  70. 680 goto260
  71. 690 if nd>0 then720
  72. 700 forx=1to24:ifb(x)<>0thennext
  73. 710 fori=1tox-1:dk(i)=b(x-i):b(x-i)=0:next:nd=x-1
  74. 720 for p=24to4step-1:b(p)=b(p-3):next:fori=1to3:b(i)=dk(4-i):next
  75. 730 nd=nd-3:for p=1to24:dk(p)=dk(p+3):next:ifnd<>abs(nd)thennd=.
  76. 740 if b(3)>0 then g=2: if b(2)>0 then g=1: if b(1)>0 then260
  77. 750 fori=1to27-g:b(i)=b(i+g):next:goto260
  78. 760 print:print"are you sure (y/n)?";:wait198,1:getok$:printok$:ifok$<>"y"then260
  79. 770 ifnwthenrun20
  80. 780 open15,8,15,"r0:hello connect=hello connect":input#15,er:close15
  81. 790 print"[147]";:ifer<>63thenend
  82. 800 poke53272,21:load"hello connect",8
  83. 810 print"where to: column 1-7, s,h,d,c    [157][157]>";:getw$:printw$
  84. 820 l=val(w$) : if l>0 and l<8 then c1=d(l,p(l)) : w$="" : return
  85. 830 s=-(w$="s")-2*(w$="h")-3*(w$="d")-4*(w$="c")
  86. 840 if s=0 thenprint"[145]";:goto810
  87. 850 return
  88. 860 for p=1to26:b(p)=b(p+1):next:goto260
  89. 870 print"you trying to cheat, podner?":
  90. 880 poke54276,.:poke54296,15:poke54273,24:poke54272,75:poke54277,28:poke54278,10
  91. 890 poke54276,33
  92. 900 form=1to2500:next:poke198,0:goto260
  93. 910 pn$="[203][204][207][206][196][201][203][197] [211][207][204][201][212][193][201][210][197]":an$="[194][217]:  [202][193][201][205] [193][206][196][210][197][215] [194][193][201][204][197][217]"
  94. 920 bo=11:sc=1:cl=06:c1=12:c2=00:c3=12:c4=00:c5=00:c6=06:c7=011
  95. 930 poke53272,21
  96. 940 poke53280,bo:poke53281,sc:print"[147]";:goto1060
  97. 950 poke646,c1:print" [164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]"
  98. 960 poke646,c2:print" [165]        [204][207][193][196][211][212][193][210] [208][210][197][211][197][206][212][211]:        [167]"
  99. 970 poke646,c1:print" [163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163]"
  100. 980 poke646,c6:print""tab(20-len(pn$)/2);pn$
  101. 990 poke646,c7:print""tab(20-len(an$)/2);an$
  102. 1000 poke646,c5:print""tab(13)"[195][207][208][217][210][201][199][200][212] 1986"
  103. 1010 printtab(9)"[195][207][205][205][207][196][207][210][197] [208][213][194][204][201][195][193][212][201][207][206][211]"
  104. 1020 poke646,c3:print" [164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]"
  105. 1030 poke646,c4:print" [165]                                  [167]"
  106. 1040 poke646,c3:print" [163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][146]";
  107. 1050 poke198,.:goto1150
  108. 1060 poke646,cl
  109. 1070 print" [172][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][187]"
  110. 1080 fora=1to3:gosub1260:next
  111. 1090 gosub1260:print"[145][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183]"
  112. 1100 fora=1to16:gosub1260:next
  113. 1110 print"[145][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175]"
  114. 1120 fora=1to3:gosub1260:next
  115. 1130 print" [188][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][146][190]";
  116. 1140 poke53280,bo:poke53281,sc:goto950
  117. 1150 print"";
  118. 1160 poke646,c2:print"[165][208]ress the [[211][208][193][195][197] [194][193][210]] to continue.[167]"
  119. 1170 fora=1to100
  120. 1180 geta$:ifa$=" "ora$="[160]"thenreturn
  121. 1190 next
  122. 1200 print"";
  123. 1210 print"[165]                                  [167]"
  124. 1220 fora=1to100
  125. 1230 geta$:ifa$=" "ora$="[160]"thenreturn
  126. 1240 next
  127. 1250 goto1150
  128. 1260 print" [161][146][161]":return
  129.